home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue57 / Str2Date / Str2Date.pas next >
Encoding:
Pascal/Delphi Source File  |  2000-01-30  |  3.2 KB  |  139 lines
  1. unit Str2Date;
  2.  
  3. {
  4.   Just a single function to extract
  5.   a date value from a string.
  6.  
  7.   Why ?  More flexible than Delphi's StrToDate.
  8.  
  9.   This is Freeware, you may use it without limitation.
  10.   No warranty is provided, use it at your own risk.
  11.   (I retain copyright on the original code)
  12. }
  13.  
  14. interface
  15.  
  16. function StrToDateNew(const sDateText: string; const bDayB4Month: boolean): TDateTime;
  17.  
  18. implementation
  19.  
  20. uses
  21.   Windows,
  22.   SysUtils;
  23.  
  24. function StrToDateNew(const sDateText: string; const bDayB4Month: boolean): TDateTime;
  25. {
  26.   Try to convert a string into a Date.
  27.   The year must be a FOUR digit year.
  28.  
  29.   Used PChar's for performance, also step over all
  30.   rubbish in in a single examination of the input string.
  31.  
  32.   Does not work on international MBCS :-(
  33. }
  34. var
  35.   sWord:  string;
  36.   iValue: integer;
  37.   bNumeric: boolean;
  38.   PBeg, PNex: PChar;
  39.   iInx, iDay, iMonth, iYear: integer;
  40. const
  41.   ZeroToNine = ['0'..'9'];
  42.   Separators = ['|', '/', '\', '-', '_', ',', '.', ' '];
  43. begin
  44.  
  45.   iDay    := 0;
  46.   iMonth  := 0;
  47.   iYear   := 0;
  48.  
  49.   // Begin at the start of the input date string.
  50.   PBeg := PChar(sDateText);
  51.   // Skip all leading blanks and separators
  52.   while PBeg^ in Separators do Inc(PBeg);
  53.  
  54.   // Empty input (string) - Empty output (31-12-1899)
  55.   // Could raise an exception instead - up to you.
  56.   if PBeg^ = #0 then
  57.     begin
  58.     Result := 1;
  59.     exit;
  60.     end;
  61.  
  62.   // Initialize
  63.   sWord := '';
  64.   iValue := 0;
  65.   PNex := PBeg;
  66.  
  67.   repeat // Here we go ...
  68.  
  69.     // Have we got a number ?
  70.     bNumeric := (PNex^ in ZeroToNine);
  71.  
  72.     if bNumeric then // Increment our integer value
  73.       iValue := iValue * 10 + Ord(PNex^) - 48; // 48 = Ord('0')
  74.  
  75.     Inc(PNex); // Step forward to the next character ...
  76.  
  77.     if (PNex^ = #0         )  // End of String
  78.     or (PNex^ in Separators) then
  79.       begin // Process our current item
  80.  
  81.       if bNumeric then
  82.         begin // Process iValue
  83.  
  84.         case iValue of
  85.           1899..3000:
  86.             iYear := iValue;
  87.           13..31:
  88.             iDay := iValue;
  89.           1..12:
  90.             if iDay <> 0 then
  91.               iMonth := iValue
  92.             else
  93.             if iMonth <> 0 then
  94.               iDay := iValue
  95.             else
  96.             if bDayB4Month then
  97.               iDay := iValue
  98.             else
  99.               iMonth := iValue;
  100.           end; // Case iValue of
  101.  
  102.         iValue := 0; // Reset
  103.         end
  104.       else
  105.         begin // Process sWord
  106.  
  107.         // If we don't already have the month
  108.         // see if this word is a month name.
  109.  
  110.         if iMonth = 0 then
  111.           begin
  112.           SetString(sWord, PBeg, PNex - PBeg);
  113.  
  114.           sWord := UpperCase(sWord);
  115.           if (PNex - PBeg) > 3 then SetLength(sWord, 3);
  116.           iInx := Pos(sWord, 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC');
  117.           if iInx > 0 then iMonth := Succ(iInx div 3);
  118.  
  119.           end; // if iMonth = 0 then
  120.  
  121.         sWord := ''; // Reset
  122.         end; // Process sWord
  123.  
  124.       // Skip any blanks and separators
  125.       while PNex^ in Separators do Inc(PNex);
  126.  
  127.       // Set start of next word or value item
  128.       PBeg := PNex;
  129.  
  130.       end; // Processed our current item
  131.  
  132.   until PBeg^ = #0;
  133.  
  134.   Result := EncodeDate(iYear, iMonth, iDay);
  135. end;
  136.  
  137. end.
  138.  
  139.